home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / TURB_VIS / TVDMX / COLLECTR.PAS < prev    next >
Pascal/Delphi Source File  |  1994-06-20  |  9KB  |  314 lines
  1.  
  2. {■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■}
  3. {                            }
  4. {    COLLECTR  --Collection Data Editing Demo    }
  5. {    tvDMX      --data editing project        }
  6. {                            }
  7. {    Copyright (c) 1992,93    Randolph Beck        }
  8. {                P.O. Box  56-0487    }
  9. {                Orlando, FL 32856    }
  10. {                CIS:  72361,753        }
  11. {                            }
  12. {■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■}
  13.  
  14. Program COLLECTR;
  15.  
  16. (*  This program demonstrates how to use unit tvDMXCOL.PAS with a collection
  17.     of records and a collection of objects.  tvDMXCOL uses TDmxCollector(a
  18.     tvDMX descendant object) to edit data in collections.
  19.  
  20.     Although TDmxCollector can be derived to work with sorted collections,
  21.     this would require some changes to the EvaluateRecord() method.
  22.     Even so, this perpetual sorting could disturb the user, so it might
  23.     still be best to transfer the data to a non-sorting collection and then
  24.     sort again afterward.
  25.  
  26.     TDmxCollectorWin is a TDmxWindow derivative that uses TDmxCollector.
  27.  
  28.     Both of the sample windows in this program are of the same structure and
  29.     appearance, but this was only to make my work easier.  It should be easy
  30.     to insert TDmxCollectorWin-windows into your programs with your data.
  31.     Just make sure that your DMX template matches the data.
  32.  
  33.  
  34.   Function fldObjectVMT(Obj : PObject) : string;
  35.  
  36.    ...generates a template prefix for an object's virtual method table.
  37.     This is declared in unit tvDMXCOL.    It should be used with collections
  38.     of TObject derivatives so that tvDMX can create VMT's when new records
  39.     are entered.  Object Obj is disposed after its VMT code is known.
  40.  
  41.     The template prefix is actually a pair of hidden fields with default
  42.     values as that of the VMT ID.
  43.  
  44.     Procedure ObjWindow() uses this function.
  45.  
  46.  *)
  47.  
  48. {$V-,X+,B-,R- }
  49.  
  50. uses
  51.     Objects, Drivers, Memory, Views, Menus, App, MsgBox,
  52.     RSet, DmxGizma, tvGizma, tvDMX, StdDMX, tvDMXCOL, tvDMXREP,
  53.     tvDMXBUF;
  54.  
  55. const
  56.     cmRecWin        =  101;
  57.     cmObjWin        =  102;
  58.     cmPrint        =  103;
  59.  
  60.     { This is the label and template for record TMyRecord. }
  61.  
  62.     _RecLabels     =  ' String Field          String Field 2          +Real         Real      Word   Seg : Ofs ';
  63.     _RecTemplate =  ' ssssssssssssssssssss| ssssssssssssssssssss║RRRRRRR.RRR |($rr,rrr.zz)|WWWWW ║ HHHH:HHHH ';
  64.     RecLabels     :  string[length(_RecLabels)]      =  _RecLabels;
  65.     RecTemplate     :  string[length(_RecTemplate)]  =  _RecTemplate;
  66.  
  67.  
  68.     { This is the label and template for object TMyObject. }
  69.  
  70.     _ObjLabels     =  ' String Field          String Field 2          +Real         Real      Word   Seg : Ofs ';
  71.     _ObjTemplate =  ' ssssssssssssssssssss| ssssssssssssssssssss║RRRRRRR.RRR |($rr,rrr.zz)|WWWWW ║ HHHH:HHHH ';
  72.     ObjLabels     :  string[length(_ObjLabels)]      =  _ObjLabels;
  73.     ObjTemplate     :  string[length(_ObjTemplate)]  =  _ObjTemplate;
  74.     { The codes to provide for a VMT are concatenated in TApp.ObjWindow. }
  75.  
  76.  
  77. type
  78.     PRecCollection  = ^TRecCollection;
  79.     TRecCollection  =  OBJECT(TCollection)
  80.       procedure FreeItem(Item : pointer);  VIRTUAL;
  81.     end;
  82.  
  83.  
  84.     PMyRecord  = ^TMyRecord;
  85.     TMyRecord  =  RECORD
  86.     S1     : string[20];
  87.     S2     : string[20];
  88.     R1,R2  : real;
  89.     W      : word;
  90.     P      : pointer;
  91.     end;
  92.  
  93.  
  94.     PMyObject  = ^TMyObject;
  95.     TMyObject  =  OBJECT(TObject)
  96.     S1     : string[20];
  97.     S2     : string[20];
  98.     R1,R2  : real;
  99.     W      : word;
  100.     P      : pointer;
  101.       constructor Init(AS1,AS2 :string; AR1,AR2 :real; AW :word; AP :pointer);
  102.     end;
  103.  
  104.  
  105.     TAppN    =  OBJECT(TAppPrn)
  106.     end;
  107.  
  108.     TApp    =  OBJECT(TAppN)
  109.       procedure HandleEvent(var Event : TEvent);  VIRTUAL;
  110.       procedure InitMenuBar;  VIRTUAL;
  111.       procedure RecWindow;
  112.       procedure ObjWindow;
  113.     end;
  114.  
  115.  
  116. var
  117.     RecCollection  :  PRecCollection;
  118.     ObjCollection  :  PCollection;
  119.  
  120.  
  121.   { ══ TRecCollection ════════════════════════════════════════════════════ }
  122.  
  123.  
  124. procedure TRecCollection.FreeItem(Item : pointer);
  125. begin
  126.   If (Item <> nil) then Dispose(PMyRecord(Item));
  127. end;
  128.  
  129.  
  130.   { ══ TMyObject ═════════════════════════════════════════════════════════ }
  131.  
  132.  
  133. constructor TMyObject.Init(AS1,AS2 :string; AR1,AR2 :real; AW :word; AP :pointer);
  134. begin
  135.   TObject.Init;
  136.   S1 := AS1;
  137.   S2 := AS2;
  138.   R1 := AR1;
  139.   R2 := AR2;
  140.   W  := AW;
  141.   P  := AP;
  142. end;
  143.  
  144.  
  145.   { ══ TApp ══════════════════════════════════════════════════════════════ }
  146.  
  147.  
  148. procedure TApp.HandleEvent(var Event : TEvent);
  149. begin
  150.   TAppN.HandleEvent(Event);
  151.   If Event.What = evCommand then
  152.     begin
  153.     Case Event.Command of
  154.       cmRecWin:     RecWindow;
  155.       cmObjWin:     ObjWindow;
  156.       cmPrint:        PrnCurrentDMX;
  157.       cmPRN_NewPage:    PrnPageStart(Event);
  158.       cmPRN_EndPage:    PrnPageEnd(Event);
  159.       cmPRN_SetOptions:    PrnSetOptions(hcNoContext, hcNoContext, hcNoContext);
  160.      else        Exit;
  161.       end;
  162.     ClearEvent(Event);
  163.     end;
  164. end;
  165.  
  166.  
  167. procedure TApp.InitMenuBar;
  168. var  R : TRect;
  169. begin
  170.   GetExtent(R);
  171.   R.B.Y := R.A.Y + 1;
  172.   MenuBar := New(PMenuBar, Init(R, NewMenu(
  173.     NewSubMenu('~C~ollector', hcNoContext, NewMenu(
  174.       NewItem('~R~ecords',  'F3',  kbF3,   cmRecWin, hcNoContext,
  175.       NewItem('~O~bjects',  'F4',  kbF4,   cmObjWin, hcNoContext,
  176.       NewLine(
  177.       NewSoundItem(hcNoContext,  { these are methods of TAppA }
  178.       NewVideoItem(hcNoContext,  { this item appears only on hi-res systems }
  179.       NewLine(
  180.       NewItem('e~X~it',  'Alt-X',  kbAltX, cmQuit,   hcNoContext,
  181.       nil)))))))),
  182.     NewSubMenu('~W~indow', hcNoContext, NewMenu(
  183.       NewItem('~S~ize/Move', 'Ctrl-F5', kbCtrlF5, cmResize, hcNoContext,
  184.       NewItem('~Z~oom',      'F5',  kbF5,    cmZoom, hcNoContext,
  185.       NewItem('~T~ile',      '',    kbNoKey, cmTile, hcNoContext,
  186.       NewItem('C~a~scade',   '',    kbNoKey, cmCascade, hcNoContext,
  187.       NewItem('~N~ext',      'F6',  kbF6,    cmNext, hcNoContext,
  188.       NewItem('~P~revious', 'Shift-F6', kbShiftF6, cmPrev, hcNoContext,
  189.       NewItem('~C~lose', 'Alt-F3',  kbAltF3, cmClose, hcNoContext,
  190.       NewLine(
  191.       NewItem('~U~ser screen', 'Alt-F5', kbAltF5, cmUserScreen, hcNoContext,
  192.       nil)))))))))),
  193.     NewSubMenu('~P~rint', hcNoContext, NewMenu(
  194.       NewItem('~P~rint',     '',    kbNoKey, cmPrint,  hcNoContext,
  195.       StdPrnMenuItems(hcNoContext,
  196.       nil))),
  197.     nil))))
  198.   ));
  199. end;
  200.  
  201.  
  202. procedure TApp.RecWindow;
  203. var  R    : TRect;
  204. begin
  205.   AssignWinRect(R, 0,0);
  206.   DeskTop^.Insert(ValidView(New(PDmxCollectorWin, Init(R,
  207.         'Record Editor',
  208.         wnNextAvail,
  209.         RecTemplate,
  210.         RecCollection,
  211.         0,  { maximum collection size (0=no limit; -1=no expansions) }
  212.         RecLabels, 11)
  213.     )));
  214. end;
  215.  
  216.  
  217. procedure TApp.ObjWindow;
  218. var  R    : TRect;
  219.      T    : string;
  220. var  W     : PWindow;
  221. begin
  222.   T := fldObjectVMT(New(PMyObject,Init('','',0.,0.,0,nil))) + ObjTemplate;
  223.   AssignWinRect(R, 0,0);
  224.  
  225.   New(W, Init(R, 'Object Editor', wnNextAvail));
  226.   With W^ do
  227.     begin
  228.     Options := Options or ofTileable;
  229.     GetExtent(R);
  230.     R.Grow(-1,-1);
  231.     Inc(R.A.Y, 2);
  232.     Insert(New(PDmxCollector, Init(T,
  233.         ObjCollection^, 0, R,
  234.         New(PDmxFLabels,   InitInsert(W, ObjLabels)),
  235.         New(PDmxExpRecInd, InitInsert(W, 10)),
  236.         StandardScrollBar(sbHorizontal),
  237.         StandardScrollBar(sbVertical))
  238.      ));
  239.     end;
  240.   DeskTop^.Insert(W);
  241. end;
  242.  
  243.  
  244.   { ══════════════════════════════════════════════════════════════════════ }
  245.  
  246.  
  247. procedure InitializeData;
  248. { creates test data }
  249.  
  250.     function NewRec(AS1,AS2 :string; AR1,AR2 :real; AW :word; AP :pointer) : PMyRecord;
  251.     var PR : PMyRecord;
  252.     begin
  253.       New(PR);
  254.       With PR^ do
  255.     begin
  256.     S1 := AS1;
  257.     S2 := AS2;
  258.     R1 := AR1;
  259.     R2 := AR2;
  260.     W  := AW;
  261.     P  := AP;
  262.     end;
  263.       NewRec := PR;
  264.     end;
  265.  
  266. begin
  267.   RecCollection^.Insert(NewRec('Abigail Adams',  'Massachusetts',1,1, 1, pointer(0)));
  268.   RecCollection^.Insert(NewRec('Betty Boop',     'ToonTown',     2,2, 2, pointer(4)));
  269.   RecCollection^.Insert(NewRec('Charlie Chaplin','IBM Archives', 3,3, 3, pointer(8)));
  270.   RecCollection^.Insert(NewRec('Doris Day',     'Hollywood',     4,4, 4, pointer(12)));
  271.   RecCollection^.Insert(NewRec('Elbert Eagleton','Elm Street',     5,5, 5, pointer(16)));
  272.  
  273.   ObjCollection^.Insert(New(PMyObject, Init('Adam West', 'Gotham City', 1,1, 1, pointer(20))));
  274.   ObjCollection^.Insert(New(PMyObject, Init('Burt Ward', 'Gotham City', 2,2, 2, pointer(24))));
  275. end;
  276.  
  277.  
  278.   { ══════════════════════════════════════════════════════════════════════ }
  279.  
  280.  
  281. procedure CloseData(Name : string;  Collection : PCollection);
  282. { displays count of records in a collection, and disposes of the collection }
  283. var  S : string;
  284. begin
  285.   FormatStr(S, '%d (0%xH) records entered into %s.',
  286.          dparam(Collection^.Count,
  287.          dparam(Collection^.Count,
  288.          sparam(@Name,
  289.              nil)))^
  290.     );
  291.   PrintStr(S + ^M^J);
  292.   Collection^.FreeAll;
  293.   Dispose(Collection, Done);
  294. end;
  295.  
  296.  
  297.   { ══════════════════════════════════════════════════════════════════════ }
  298.  
  299.  
  300. var  MyApp : TApp;
  301.  
  302. Begin
  303.   New(RecCollection, Init(200, 10));
  304.   New(ObjCollection, Init(200, 10));
  305.   InitializeData;
  306.  
  307.   MyApp.Init;
  308.   MyApp.Run;
  309.   MyApp.Done;
  310.  
  311.   CloseData('RecCollection', RecCollection);
  312.   CloseData('ObjCollection', ObjCollection);
  313. End.
  314.